{ Logging.pas  SMTP interface component

 	Copyright (C) 2003 - 20xx Stephan Stapel
        (stephan.stapel@web.de)

  This file is part of gnupgcomponents, ocx package.

  GnuPGEngine and GnuPGPublickeyring is free software;
  you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  This library is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this library; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
unit Logging;

interface

uses Classes,SysUtils;

type TLogging=class(TObject)
       constructor Create;
       destructor Destroy; override;
     private
       CurrentFileName: String;    // bei daily-Einstellung aendert sich der Name laufend
       FileSuffix: String;         // kann vom Benutzer festgelegt werden
       Directory: String;          // kann ebenfalls vom Benutzer festgelegt werden
       FOnCallBack: TNotifyEvent;  // auch vom Benutzer festgelegt, benachrichtigt den
                                   // Besitzer der Komponente ueber einen neuen Eintrag
       LastEntry: String;          // Letzter Eitnrag, der hinzugefuegt wurde
       LogStack: TStringList;      // alle eingetragenen Elemente
     public
       Daily: Boolean;             // Taeglich neue Datei anfangen?
       function AddMessage(aString: String): Boolean;
       procedure SetFileSuffix(aString: String);
       procedure SetDirectory(aString: String);
       function DirExists(aDir: String): Boolean;
       function GetLastEntry: String;
       function GetFileName: String;
       function GetDirectory: String;
       procedure ClearLogStack;
       function GetLogStack:TStringList;
     published
       property OnCallback: TNotifyEvent read FOnCallBack write FOnCallBack;
     end;


implementation


constructor TLogging.Create;
begin
  Daily:=TRUE;
  FOnCallBack:=nil;
  LastEntry:='';
  CurrentFileName:='';
  LogStack:=TStringList.Create;
  AddMessage('---------------- Logging initialisiert ---------------');
end;


destructor TLogging.Destroy;
begin
  LogStack.Clear;
  LogStack.Free;
end;


function TLogging.AddMessage;
var f: Textfile;
    oldShortDateFormat:String;
    rec: TSearchRec;
    filename: String;
    isFound: Boolean;
begin
  if not DirExists(Directory) then
    if not CreateDir(Directory) then begin
      result:=FALSE;
      exit;
    end;

  if Daily then begin
    // den Dateinamen ermitteln
    oldShortDateFormat:=ShortDateFormat;
    ShortDateFormat:='yymmdd';
    filename:=FileSuffix+'_'+DateToStr(date)+'.log';
    ShortDateFormat:=oldShortDateFormat;
  end
  else
    filename:=FileSuffix+'.log';

  if FindFirst(Directory+'\'+filename,faAnyFile,rec)=0 then
     isFound:=true
  else
     isFound:=false;
  FindClose(rec);

  AssignFile(f,Directory+'\'+filename);
  {$I-}
  if isFound then
    Append(f)
  else
    ReWrite(f);
  if IOResult<>0 then
    Writeln('Fehler beim Schreiben des Logfiles!')
  else
    Writeln(f,DateToStr(Date)+', '+TimeToStr(now)+' - '+aString);
  Closefile(f);
  {$I+}

  // bestimmte Stati abspeichern
  CurrentFileName:=FileName;
  LastEntry:=aString;

  // die Nachricht abspeichern
  if LogStack.Count>1000 then
    ClearLogStack;
  LogStack.Add(LastEntry);

  // den Besitzer benachrichtigen
  if Assigned(FOnCallback) then
    FOnCallBack(self);

  result:=TRUE;
end;


procedure TLogging.SetFileSuffix;
begin
  FileSuffix:=aString;
end;


procedure TLogging.SetDirectory;
begin
  Directory:=aString;
  if Directory[Length(Directory)]='\' then
    Directory:=Copy(Directory,1,Length(Directory)-1);
end;


function TLogging.DirExists;
var rec:TSearchRec;
begin
  if Length(aDir)=0 then begin
    result:=FALSE;
    exit;
  end;

  if aDir[Length(aDir)]='\' then
    aDir:=copy(aDir,0,Length(aDir)-1);
    if FindFirst(aDir,faDirectory,rec)<>0 then
      result:=false
    else
      result:=true;

  FindClose(rec);
end;


function TLogging.GetLastEntry;
begin
  result:=LastEntry;
end;


function TLogging.GetFilename;
begin
  result:=CurrentFileName;
end;


function TLogging.GetDirectory;
begin
  result:=Directory;
end;


procedure TLogging.ClearLogStack;
begin
  if LogStack=nil then
    LogStack:=TStringList.Create;

  LogStack.Clear;
end;


function TLogging.GetLogStack;
begin
  result:=LogStack;
end;

end.
